home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 032 (1987-11-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 032 (1987-11-15)(Ossowski, Stefan)(DE)(PD).adf / Koch-Hilbert-Kurven < prev    next >
Text File  |  1989-01-18  |  7KB  |  273 lines
  1. '          **************************************************************
  2. '          ****************      Koch/Hilbert Kurven      ***************
  3. '          **************      -----------------------      *************
  4. '          ************   fÜr den AMIGA erweitert 1987 von    ***********
  5. '          *************           Andreas Werner            ************
  6. '          **************  Blumenstr.13 / 7ooo Stuttgart-1  ************* 
  7. '          **************************************************************
  8.  
  9. 'Public Domain zusammen mit 'KH-Dok.'
  10.  
  11. 'SPRACHE :    AMIGA BASIC
  12.  
  13. start:
  14. SCREEN 2,640,200,1,2:WINDOW 3,,,16,2
  15. clrscrn:
  16. CLEAR ,,4789
  17. WINDOW 2,"**********************      Koch / Hilbert - Kurven     ***********************",,0,2
  18. PALETTE 0,0,0,0:PALETTE 1,.75,.75,.75: COLOR 0,1
  19. FOR f=0 TO 8:READ m$(f):NEXT f
  20. DATA " Dreieck"," Quadrat"," FÜnfeck"," Sechseck"
  21. DATA "Siebeneck"," Achteck"," Hilbert"," Ansehen","Speichern"
  22. pi=3.14159256#:DEFSNG a,d
  23. WINDOW 2:CLS
  24. FOR f=3 TO 11  
  25.   LOCATE (f-1)*2,14:PRINT m$(f-3):                        REM Menue
  26. NEXT f
  27. LINE(374,149)-(476,161),0,b:LINE(371,147)-(479,163),0,b
  28. LOCATE 20,52:PRINT "QUIT"
  29. LINE(56,15)-(223,165),0,b:LINE(59,17)-(220,163),0,b
  30. maus:
  31. GOSUB click
  32. x=MOUSE(1):y=MOUSE(2)
  33. FOR a=3 TO 11
  34.   IF y>20+(a-3)*16 AND y<35+(a-3)*16 THEN mark:           REM Mausauswahl     
  35. NEXT a      
  36. a$=INKEY$:IF a$="q" OR a$="a" THEN mark:                  REM Tastaturauswahl
  37. a=VAL(a$):IF a<3 OR a>11 THEN maus
  38. mark:
  39. IF a=10 OR a$="a" THEN
  40.   WINDOW 3:                                               REM Ansehen
  41.   GOSUB click:GOTO clrscrn
  42. END IF   
  43. IF a=11 AND x>280 OR a$="q" THEN
  44.   LOCATE 10,45:PRINT "Moment bitte ...  ":LIST:           REM Quit
  45.   WINDOW CLOSE 2: END
  46. END IF
  47. IF a=11 AND x<280 OR a$="s" THEN iffsave
  48. GOSUB dimension
  49. LINE(65,a+(a-2)*15+3)-(214,a+(a-2)*15+15),0,b
  50. LINE(62,a+(a-2)*15+1)-(217,a+(a-2)*15+17),0,b
  51. GOSUB xitin:                                              REM Iterat. wählen
  52. WINDOW 3:COLOR 0,1:CLS
  53. IF a=9 THEN hilbert
  54. CLS:MOUSE ON:ON MOUSE GOSUB stoppen
  55. d=0
  56. nextit:
  57.   it=xit(d):se=600:xp=15:yp=166:w=0
  58.   IF a=5 THEN se=se/1.08:xp=28:yp=178:                    REM GrÖße einstellen...
  59.   IF a=6 THEN se=se/1.57:xp=126
  60.   IF a=7 THEN se=se/1.85:xp=144:yp=162
  61.   IF a=8 THEN se=se/2.38:xp=172:yp=154
  62.   GOSUB koch:                                             REM und rechnen
  63. d=d+1:IF d<eit THEN nextit
  64. scan:
  65. a$=INKEY$:IF a$<>"" THEN clrscrn
  66. GOSUB click:GOTO clrscrn
  67.  
  68. koch:
  69. IF it=0 THEN
  70.   s=se:GOSUB schreite:RETURN
  71. END IF                           
  72. it=it-1:se=se/3: GOSUB koch
  73. a1=a-2:ON a1 GOSUB kochd,kochq,kochf,kochs,kochsi,kocha
  74. it=it+1:se=se*3
  75. RETURN
  76.  
  77. kochd:
  78. w=w-60: GOSUB koch
  79. w=w+120:GOSUB koch
  80. w=w-60: GOSUB koch
  81. RETURN
  82.  
  83. kochq:
  84. w=w-90:GOSUB koch
  85. w=w+90:GOSUB koch
  86. w=w+90:GOSUB koch  
  87. w=w-90:GOSUB koch
  88. RETURN
  89.  
  90. kochf:
  91. w=w-(180-(360/5)):GOSUB koch
  92. w=w+360/5:GOSUB koch
  93. w=w+360/5:GOSUB koch
  94. w=w+360/5:GOSUB koch
  95. w=w-(180-(360/5)):GOSUB koch
  96. RETURN
  97.  
  98.  
  99. kochs:
  100. w=w-120:GOSUB koch
  101. w=w+60 :GOSUB koch
  102. w=w+60 :GOSUB koch
  103. w=w+60 :GOSUB koch
  104. w=w+60 :GOSUB koch
  105. w=w-120:GOSUB koch
  106. RETURN
  107.  
  108. kochsi:
  109. w=w-(180-(360/7)):GOSUB koch
  110. w=w+360/7:GOSUB koch
  111. w=w+360/7:GOSUB koch
  112. w=w+360/7:GOSUB koch
  113. w=w+360/7:GOSUB koch
  114. w=w+360/7:GOSUB koch
  115. w=w-(180-(360/7)):GOSUB koch
  116. RETURN
  117.  
  118. kocha:
  119. w=w-(180-(360/8)):GOSUB koch
  120. w=w+360/8:GOSUB koch
  121. w=w+360/8:GOSUB koch
  122. w=w+360/8:GOSUB koch
  123. w=w+360/8:GOSUB koch
  124. w=w+360/8:GOSUB koch
  125. w=w+360/8:GOSUB koch
  126. w=w-(180-(360/8)):GOSUB koch
  127. RETURN
  128.    
  129.  
  130. hilbert:
  131. MOUSE ON:ON MOUSE GOSUB stoppen
  132. CLS:d=0
  133. hil1:
  134.   it=xit(d)+1:sp=95/2^(it):se=95/2^(it-1):xp=126+sp:yp=192-sp:w=0:r=1
  135.   se=se*2
  136.   GOSUB hilbi
  137. d=d+1:IF d<eit THEN hil1
  138. GOTO scan
  139.  
  140. hilbi:
  141. IF it=0 THEN RETURN
  142. w=w-90*r
  143. it=it-1:r=-r:GOSUB hilbi:r=-r
  144. s=se:GOSUB schreite
  145. w=w+90*r:GOSUB hilbi
  146. s=se:GOSUB schreite:GOSUB hilbi
  147. w=w+90*r
  148. s=se:GOSUB schreite
  149. r=-r:GOSUB hilbi:r=-r:it=it+1
  150. w=w-90*r
  151. RETURN
  152.  
  153.  
  154. schreite:
  155. xs=s*COS(w*pi/180)
  156. ys=s/2*SIN(w*pi/180)
  157. xp=xp+xs:yp=yp+ys
  158. LINE (xp-xs,yp-ys)-(xp,yp),0
  159. RETURN
  160.        
  161. xitin:
  162. LOCATE 11,46:PRINT "Iterationen ?"
  163. LINE(297,73)-(532,126),0,b:LINE(300,75)-(529,124),0,b 
  164. FOR xb=304 TO 472 STEP 56
  165.   LINE(xb,92)-(xb+53,106),0,b:LINE(xb,108)-(xb+53,122),0,b
  166.   LOCATE 13,(xb/8)+3:PRINT (xb-304)/56
  167.   LOCATE 15,(xb/8)+3:PRINT (xb-304)/56+4
  168.   IF a<9 THEN
  169.     LOCATE 15,56:PRINT " ":LOCATE 15,63:PRINT " "
  170.   END IF  
  171. NEXT xb
  172. GOSUB okgadget:eit=0  
  173. mausin:
  174. GOSUB click:x=MOUSE(1):y=MOUSE(2)
  175.   IF y>92 AND y<106 THEN 
  176.     FOR i=1 TO 4
  177.       IF x>304+56*(i-1) AND x<302+56*i THEN
  178.         LINE(307+56*(i-1),94)-(298+56*i,104),0,b
  179.         xit(eit)=i-1
  180.       END IF
  181.     NEXT i
  182.   END IF  
  183.   IF y>108 AND y<124 THEN
  184.     FOR i=5 TO 8
  185.       IF x>304+56*(i-5) AND x<302+56*(i-4) THEN
  186.         IF a<9 AND i>6 THEN mausin
  187.         LINE(307+56*(i-5),110)-(298+56*(i-4),120),0,b
  188.         xit(eit)=i-1
  189.       END IF
  190.     NEXT i
  191.   END IF    
  192.   IF y>149 AND y<161 THEN
  193.     IF x>303 AND x<368 THEN clrscrn:                         REM cancel 
  194.     IF x>482 AND x<526 THEN RETURN:                          REM ok
  195.   END IF
  196. IF a<9 AND eit>6 OR a=9 AND eit>8 THEN mausin
  197. eit=eit+1:GOTO mausin
  198.  
  199. okgadget:
  200. LINE(297,145)-(532,165),0,b:LINE(300,147)-(529,163),0,b
  201. LINE(303,149)-(368,161),0,b:LOCATE 20,40:PRINT "CANCEL"
  202. LOCATE 20,51:PRINT "       "
  203. LINE(482,149)-(526,161),0,b:LOCATE 20,63:PRINT "OK"
  204. RETURN
  205.  
  206. dimension:
  207. di=LOG(a+1)/LOG(3!)
  208. LINE(297,15)-(532,40),0,b
  209. LINE(300,17)-(529,38),0,b
  210. LINE(303,19)-(526,36),0,b
  211. LOCATE 4,42:PRINT "Dimension : ";di
  212. RETURN
  213.  
  214. stoppen:
  215. MOUSE OFF
  216. RETURN clrscrn
  217.  
  218. click:
  219. z=MOUSE(0):WHILE MOUSE(0)=0:WEND
  220. WHILE MOUSE(0)<>0:WEND:RETURN
  221.  
  222. iffsave:
  223. LOCATE 11,47:PRINT "Dateiname :"
  224. LINE(297,73)-(532,110),0,b:LINE(300,75)-(529,108),0,b
  225. LINE(303,92)-(526,106),0,b
  226. LOCATE 13,40:INPUT n$
  227. IF LEN(n$)=0 THEN clrscrn
  228. IF LEN(n$)>15 THEN n$=LEFT$(n$,15)
  229. GOSUB okgadget
  230. savmaus:
  231. GOSUB click:x=MOUSE(1):y=MOUSE(2)
  232. IF y>149 AND y<161 THEN
  233.   IF x>303 AND x<368 THEN GOTO clrscrn:              REM cancel
  234.   IF x<482 AND x>526 THEN savmaus                        
  235. END IF
  236. WINDOW 3
  237. ON ERROR GOTO saverror:                              REM ok
  238. ad&=PEEKL(PEEKL(WINDOW(8)+4)+8):                     REM Window-Adresse
  239. bmgr=20:                                             REM CHUNK-
  240. cmgr=2*3:                                            REM Größen
  241. bogr=200*640/8*1:                                    REM berechnen
  242. fogr=12+bmgr+8+cmgr+8+bogr:                          REM
  243. OPEN n$ FOR OUTPUT AS #1 LEN=8192
  244. PRINT #1,"FORM";MKL$(fogr);"ILBM";:                  REM FORM-Chunk
  245. PRINT #1,"BMHD";MKL$(bmgr);:                         REM BMHD-Chunk
  246. PRINT #1,MKI$(640);MKI$(200);MKL$(0);
  247. PRINT #1,CHR$(1);CHR$(0);MKI$(0);
  248. PRINT #1,MKI$(0);CHR$(10);CHR$(11);
  249. PRINT #1,MKI$(640);MKI$(200);
  250. PRINT #1,"CMAP";MKL$(cmgr);:                         REM CMAP-Chunk
  251. PRINT #1,CHR$(0);CHR$(0);CHR$(0);
  252. PRINT #1,CHR$(192);CHR$(192);CHR$(192);
  253. PRINT #1,"BODY";MKL$(bogr);:                         REM BODY-Chunk
  254. FOR y=0 TO 199
  255.   za&=ad&+80*y
  256.   FOR x=0 TO 79 STEP 4
  257.     PRINT #1,MKL$(PEEKL(za&+x));
  258.   NEXT x:PSET(1,y),0
  259. NEXT y:LINE(1,0)-(1,199),1
  260. CLOSE #1:GOTO clrscrn
  261.     
  262. saverror:
  263. LOCATE 10,28:PRINT "                           "
  264. LOCATE 11,28:PRINT "   ACHTUNG  DISK-ERROR !   "
  265. LOCATE 12,28:PRINT "   ---------------------   "
  266. LOCATE 13,28:PRINT "    Maustaste drÜcken !    "
  267. LOCATE 14,28:PRINT "                           "
  268. LINE(220,70)-(442,114),1,b:LINE(217,68)-(445,116),1,b
  269. GOSUB click: WINDOW CLOSE 3:RESUME clrscrn                           
  270.  
  271.  
  272.         
  273.